Preparations for analysis
Loading packages to simulate and manipulate data.
Registered S3 methods overwritten by 'dbplyr':
method from
print.tbl_lazy
print.tbl_sql
── Attaching packages ────────────────────── tidyverse 1.3.1 ──
✓ ggplot2 3.3.3 ✓ purrr 0.3.4
✓ tibble 3.1.1 ✓ dplyr 1.0.6
✓ tidyr 1.1.3 ✓ stringr 1.4.0
✓ readr 2.1.1 ✓ forcats 0.5.1
── Conflicts ───────────────────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag() masks stats::lag()
Import data
academic <- readxl::read_excel("data/Base de datos - Calidad Academica.xlsx")
New names:
* Respuesta -> Respuesta...6
* Respuesta -> Respuesta...7
* Respuesta -> Respuesta...8
Data Analysis
Population correlation
correlation_population <- academic %>%
correlation() %>%
as_tibble()
correlation_population
Sampling generation
academic_nest <- academic %>%
group_nest()
set.seed(2022)
number_seed <- round(runif(100, 1, 1000))
academic_sample_list <- list()
for(i in 1:100) {
set.seed(number_seed[i])
academic_sample_list[[i]] <- academic_nest %>%
mutate(
sample_50 = map(data,
~ slice_sample(., n = 50)),
sample_100 = map(data,
~ slice_sample(., n = 100)),
sample_250 = map(data,
~ slice_sample(., n = 250)),
sample_500 = map(data,
~ slice_sample(., n = 500)),
sample_1000 = map(data,
~ slice_sample(., n = 1000)),
)
}
academic_sample_final <- bind_rows(academic_sample_list,
.id = "Replication")
Format data to tidy structure
academic_sample_final <- academic_sample_final %>%
select(-data) %>%
pivot_longer(
cols = sample_50:sample_1000,
names_to = "sample_n",
values_to = "data"
) %>%
mutate(sample_n = str_remove(sample_n, "sample_")) %>%
unnest("data")
Correlation analysis
Pearson correlation
correlation_pearson <- academic_sample_final %>%
group_by(sample_n, Replication) %>%
correlation(method = "pearson",
p_adjust = "none") %>%
as_tibble()
correlation_pearson
Spearman correlation:
correlation_spearman <- academic_sample_final %>%
group_by(sample_n, Replication) %>%
correlation(method = "spearman",
p_adjust = "none") %>%
as_tibble()
correlation_spearman
Winzorized correlation:
correlation_winzorized <- academic_sample_final %>%
group_by(sample_n, Replication) %>%
correlation(winsorize = 0.2,
p_adjust = "none") %>%
as_tibble()
correlation_winzorized
Joined correlations
correlation_joins <- correlation_pearson %>%
select(Group:r, Method) %>%
bind_rows(
correlation_spearman %>%
select(Group:rho, Method) %>%
rename(r = rho),
correlation_winzorized %>%
select(Group:r, Method)
)
Evaluate correlation in data example
Calculate RMSEA and Bias
correlation_evaluate <- correlation_format %>%
rowwise() %>%
mutate(
dif_r = (r - correlation)/correlation
) %>%
group_by(correlation, n, Method) %>%
summarise(
ARMSEA = sqrt(sum(dif_r^2)/100),
Bias = sum(dif_r)/100
) %>%
ungroup()
correlation_evaluate <- correlation_evaluate %>%
mutate(
across(correlation:n, factor)
) %>%
pivot_longer(
cols = ARMSEA:Bias,
names_to = "Evaluate",
values_to = "Value"
)
Generate plot
plot_ev_data_A <- correlation_evaluate %>%
ggplot(aes(x = Method,
y = Value,
linetype = Evaluate,
group = Evaluate)) +
geom_point(color = "#3a3a3a", size = 2) +
geom_path(color = "#3a3a3a") +
labs(title = NULL,
x = "Correlation Methods",
y = NULL) +
scale_x_discrete(guide = guide_axis(n.dodge = 2)) +
facet_grid(correlation ~ n) +
theme_bw() +
theme(
plot.title = element_text(hjust = 0.5,
size = 12,
face = "bold"),
plot.subtitle = element_text(hjust = 0.5),
text = element_text(
size = 11,
face="bold"),
axis.text = element_text(
size = 9,
face="plain",
colour="black"),
# axis.text.x = element_text(angle = 90),
axis.title.x = element_text(
size = 11,
margin = margin(t = 7, r = 0, b = 0, l = 0)
),
strip.text = element_text(
size = 11
),
legend.title = element_blank(),
legend.text = element_text(
face="plain",
colour="black",
size=10),
panel.spacing = unit(0.8, "lines")
)
# ggsave(filename = "img/Evaluate_correlation_RMSEA_Bias_data_example_A.png",
# plot = plot_ev_data_A, width = 10.75, height = 7,
# dpi = 300)

LS0tCnRpdGxlOiAiQ29ycmVsYXRpb24gZXhhbXBsZSBkYXRhIgpkYXRlOiAiMDYvMDEvMjAyMiIKYXV0aG9yOgogIC0gbmFtZTogSm9zw6kgVmVudHVyYS1MZcOzbgogICAgZW1haWw6IGpvc2UudmVudHVyYUB1cG4ucGUKICAgIGFmZmlsaWF0aW9uOiBVbml2ZXJzaWRhZCBQcml2YWRhIGRlbCBOb3J0ZQogIC0gbmFtZTogQnJpYW4gTi4gUGXDsWEtQ2FsZXJvCiAgICBlbWFpbDogYnJpYW5tc21AZ21haWwuY29tCiAgICBhZmZpbGlhdGlvbjogR3J1cG8gZGUgRXN0dWRpb3MgQXZhbmNlcyBlbiBNZWRpY2nDs24gUHNpY29sw7NnaWNhLCBVbml2ZXJzaWRhZCBOYWNpb25hbCBNYXlvciBkZSBTYW4gTWFyY29zLCBMaW1hLCBQZXLDugpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6IAogICAgbnVtYmVyX3NlY3Rpb25zOiB5ZXMKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwogICAgaGlnaGxpZ2h0OiBrYXRlCiAgICB0aGVtZTogZmxhdGx5Ci0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgojIFByZXBhcmF0aW9ucyBmb3IgYW5hbHlzaXMKCkxvYWRpbmcgcGFja2FnZXMgdG8gc2ltdWxhdGUgYW5kIG1hbmlwdWxhdGUgZGF0YS4gCgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoY29ycmVsYXRpb24pCmBgYAoKIyBJbXBvcnQgZGF0YQoKYGBge3J9CmFjYWRlbWljIDwtIHJlYWR4bDo6cmVhZF9leGNlbCgiZGF0YS9CYXNlIGRlIGRhdG9zIC0gQ2FsaWRhZCBBY2FkZW1pY2EueGxzeCIpCmBgYAoKCiMgRm9ybWF0IGRhdGEKCmBgYHtyfQphY2FkZW1pYyA8LSBhY2FkZW1pYyAlPiUgCiAgcm93d2lzZSgpICU+JSAKICBtdXRhdGUoCiAgICBFU0EgPSBzdW0oY19hY3Jvc3MoYyhFUzE6RVM4KSkpLAogICAgVVdFU19kaXJlY3Rpb24gPSBzdW0oY19hY3Jvc3MoYyhVV0VTNiwgVVdFUzksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBVV0VTMTEsIFVXRVMxNSkpKSwKICAgIFVXRVNfYWN0aXZhdGlvbiA9IHN1bShjX2Fjcm9zcyhjKFVXRVM1LCBVV0VTNywgVVdFUzEzLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgVVdFUzIsIFVXRVMzLCBVV0VTNCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIFVXRVMxNCwgVVdFUzE3KSkpCiAgKSAlPiUgCiAgdW5ncm91cCgpICU+JSAKICBzZWxlY3QoRVNBOlVXRVNfYWN0aXZhdGlvbikKYGBgCgojIERhdGEgQW5hbHlzaXMKCiMgUG9wdWxhdGlvbiBjb3JyZWxhdGlvbgoKYGBge3J9CmNvcnJlbGF0aW9uX3BvcHVsYXRpb24gPC0gYWNhZGVtaWMgJT4lIAogIGNvcnJlbGF0aW9uKCkgJT4lIAogIGFzX3RpYmJsZSgpCgpjb3JyZWxhdGlvbl9wb3B1bGF0aW9uCmBgYAoKIyBTYW1wbGluZyBnZW5lcmF0aW9uCgpgYGB7cn0KYWNhZGVtaWNfbmVzdCA8LSBhY2FkZW1pYyAlPiUgCiAgZ3JvdXBfbmVzdCgpIAoKc2V0LnNlZWQoMjAyMikKbnVtYmVyX3NlZWQgPC0gcm91bmQocnVuaWYoMTAwLCAxLCAxMDAwKSkKCmFjYWRlbWljX3NhbXBsZV9saXN0IDwtIGxpc3QoKQpmb3IoaSBpbiAxOjEwMCkgewogIHNldC5zZWVkKG51bWJlcl9zZWVkW2ldKSAKICBhY2FkZW1pY19zYW1wbGVfbGlzdFtbaV1dIDwtIGFjYWRlbWljX25lc3QgJT4lIAogICAgbXV0YXRlKAogICAgc2FtcGxlXzUwID0gbWFwKGRhdGEsIAogICAgICAgICAgICAgICAgICAgIH4gc2xpY2Vfc2FtcGxlKC4sIG4gPSA1MCkpLAogICAgc2FtcGxlXzEwMCA9IG1hcChkYXRhLCAKICAgICAgICAgICAgICAgICAgICB+IHNsaWNlX3NhbXBsZSguLCBuID0gMTAwKSksCiAgICBzYW1wbGVfMjUwID0gbWFwKGRhdGEsIAogICAgICAgICAgICAgICAgICAgIH4gc2xpY2Vfc2FtcGxlKC4sIG4gPSAyNTApKSwKICAgIHNhbXBsZV81MDAgPSBtYXAoZGF0YSwgCiAgICAgICAgICAgICAgICAgICAgfiBzbGljZV9zYW1wbGUoLiwgbiA9IDUwMCkpLAogICAgc2FtcGxlXzEwMDAgPSBtYXAoZGF0YSwgCiAgICAgICAgICAgICAgICAgICAgICB+IHNsaWNlX3NhbXBsZSguLCBuID0gMTAwMCkpLAogICkKfQpgYGAKCmBgYHtyfQphY2FkZW1pY19zYW1wbGVfZmluYWwgPC0gYmluZF9yb3dzKGFjYWRlbWljX3NhbXBsZV9saXN0LCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAuaWQgPSAiUmVwbGljYXRpb24iKQpgYGAKCkZvcm1hdCBkYXRhIHRvIHRpZHkgc3RydWN0dXJlCgpgYGB7cn0KYWNhZGVtaWNfc2FtcGxlX2ZpbmFsIDwtIGFjYWRlbWljX3NhbXBsZV9maW5hbCAlPiUgCiAgc2VsZWN0KC1kYXRhKSAlPiUgCiAgcGl2b3RfbG9uZ2VyKAogICAgY29scyA9IHNhbXBsZV81MDpzYW1wbGVfMTAwMCwKICAgIG5hbWVzX3RvID0gInNhbXBsZV9uIiwKICAgIHZhbHVlc190byA9ICJkYXRhIgogICkgJT4lIAogIG11dGF0ZShzYW1wbGVfbiA9IHN0cl9yZW1vdmUoc2FtcGxlX24sICJzYW1wbGVfIikpICU+JSAKICB1bm5lc3QoImRhdGEiKQpgYGAKCiMgQ29ycmVsYXRpb24gYW5hbHlzaXMKCiMjIFBlYXJzb24gY29ycmVsYXRpb24KCmBgYHtyfQpjb3JyZWxhdGlvbl9wZWFyc29uIDwtIGFjYWRlbWljX3NhbXBsZV9maW5hbCAlPiUgCiAgZ3JvdXBfYnkoc2FtcGxlX24sIFJlcGxpY2F0aW9uKSAlPiUgCiAgY29ycmVsYXRpb24obWV0aG9kID0gInBlYXJzb24iLAogICAgICAgICAgICAgIHBfYWRqdXN0ID0gIm5vbmUiKSAlPiUgCiAgYXNfdGliYmxlKCkKCmNvcnJlbGF0aW9uX3BlYXJzb24KYGBgCgojIyBTcGVhcm1hbiBjb3JyZWxhdGlvbjoKCmBgYHtyfQpjb3JyZWxhdGlvbl9zcGVhcm1hbiA8LSBhY2FkZW1pY19zYW1wbGVfZmluYWwgJT4lIAogIGdyb3VwX2J5KHNhbXBsZV9uLCBSZXBsaWNhdGlvbikgJT4lIAogIGNvcnJlbGF0aW9uKG1ldGhvZCA9ICJzcGVhcm1hbiIsCiAgICAgICAgICAgICAgcF9hZGp1c3QgPSAibm9uZSIpICU+JSAKICBhc190aWJibGUoKQoKY29ycmVsYXRpb25fc3BlYXJtYW4KYGBgCgojIyBXaW56b3JpemVkIGNvcnJlbGF0aW9uOgoKYGBge3J9CmNvcnJlbGF0aW9uX3dpbnpvcml6ZWQgPC0gYWNhZGVtaWNfc2FtcGxlX2ZpbmFsICU+JSAKICBncm91cF9ieShzYW1wbGVfbiwgUmVwbGljYXRpb24pICU+JSAKICBjb3JyZWxhdGlvbih3aW5zb3JpemUgPSAwLjIsCiAgICAgICAgICAgICAgcF9hZGp1c3QgPSAibm9uZSIpICU+JSAKICBhc190aWJibGUoKQoKY29ycmVsYXRpb25fd2luem9yaXplZApgYGAKCgojIyBKb2luZWQgY29ycmVsYXRpb25zCgpgYGB7cn0KY29ycmVsYXRpb25fam9pbnMgPC0gY29ycmVsYXRpb25fcGVhcnNvbiAlPiUgCiAgc2VsZWN0KEdyb3VwOnIsIE1ldGhvZCkgJT4lIAogIGJpbmRfcm93cygKICAgIGNvcnJlbGF0aW9uX3NwZWFybWFuICU+JSAKICAgICAgc2VsZWN0KEdyb3VwOnJobywgTWV0aG9kKSAlPiUgCiAgICAgIHJlbmFtZShyID0gcmhvKSwKICAgIGNvcnJlbGF0aW9uX3dpbnpvcml6ZWQgJT4lIAogICAgICBzZWxlY3QoR3JvdXA6ciwgTWV0aG9kKQogICkKYGBgCgojIyBGb3JtYXQgY29ycmVsYXRpb24gdGliYmxlCgpgYGB7cn0KY29ycmVsYXRpb25fZm9ybWF0IDwtIGNvcnJlbGF0aW9uX2pvaW5zICU+JSAKICBzZXBhcmF0ZShHcm91cCwKICAgICAgICAgICBpbnRvID0gYygibiIsICJyZXAiKSwKICAgICAgICAgICBzZXAgPSAiIC0gIikgJT4lIAogIG11dGF0ZSgKICAgIG4gPSBhcy5udW1lcmljKG4pLAogICAgcmVwID0gZmFjdG9yKHJlcCwgCiAgICAgICAgICAgICAgICAgbGV2ZWxzID0gYXMuY2hhcmFjdGVyKDE6MTAwKSksCiAgICBNZXRob2QgPSBzdHJfcmVtb3ZlKE1ldGhvZCwgIiBjb3JyZWxhdGlvbiIpLAogICAgTWV0aG9kID0gZmN0X3JlY29kZShNZXRob2QsCiAgICAgICAgICAgICAgICAgICAgICAgICJXaW5zb3JpemVkIiA9ICJXaW5zb3JpemVkIFBlYXJzb24iKQogICkgJT4lIAogIGxlZnRfam9pbigKICAgIGNvcnJlbGF0aW9uX3BvcHVsYXRpb24gJT4lIAogICAgICBzZWxlY3QoUGFyYW1ldGVyMSwgUGFyYW1ldGVyMiwgY29ycmVsYXRpb24gPSByKSAlPiUgCiAgICAgIG11dGF0ZShjb3JyZWxhdGlvbiA9IHJvdW5kKGNvcnJlbGF0aW9uLCAzKSkKICApICU+JSAKICByZWxvY2F0ZShjb3JyZWxhdGlvbiwgbiwgcmVwLCBNZXRob2QpICU+JSAKICBhcnJhbmdlKGNvcnJlbGF0aW9uLCBuLCByZXAsIE1ldGhvZCkKCmNvcnJlbGF0aW9uX2Zvcm1hdApgYGAKCiMgRXZhbHVhdGUgY29ycmVsYXRpb24gaW4gZGF0YSBleGFtcGxlIAoKIyMgQ2FsY3VsYXRlIFJNU0VBIGFuZCBCaWFzCgpgYGB7cn0KY29ycmVsYXRpb25fZXZhbHVhdGUgPC0gY29ycmVsYXRpb25fZm9ybWF0ICU+JSAKICByb3d3aXNlKCkgJT4lIAogIG11dGF0ZSgKICAgIGRpZl9yID0gKHIgLSBjb3JyZWxhdGlvbikvY29ycmVsYXRpb24KICApICU+JSAKICBncm91cF9ieShjb3JyZWxhdGlvbiwgbiwgTWV0aG9kKSAlPiUgCiAgc3VtbWFyaXNlKAogICAgQVJNU0VBID0gc3FydChzdW0oZGlmX3JeMikvMTAwKSwKICAgIEJpYXMgPSBzdW0oZGlmX3IpLzEwMAogICkgJT4lIAogIHVuZ3JvdXAoKSAKCmNvcnJlbGF0aW9uX2V2YWx1YXRlIDwtIGNvcnJlbGF0aW9uX2V2YWx1YXRlICU+JSAKICBtdXRhdGUoCiAgICBhY3Jvc3MoY29ycmVsYXRpb246biwgZmFjdG9yKQogICkgJT4lIAogIHBpdm90X2xvbmdlcigKICAgIGNvbHMgPSBBUk1TRUE6QmlhcywKICAgIG5hbWVzX3RvID0gIkV2YWx1YXRlIiwKICAgIHZhbHVlc190byA9ICJWYWx1ZSIKICApCmBgYAoKIyMgR2VuZXJhdGUgcGxvdAoKYGBge3J9CnBsb3RfZXZfZGF0YV9BIDwtIGNvcnJlbGF0aW9uX2V2YWx1YXRlICU+JSAKICBnZ3Bsb3QoYWVzKHggPSBNZXRob2QsCiAgICAgICAgICAgICB5ID0gVmFsdWUsCiAgICAgICAgICAgICBsaW5ldHlwZSA9IEV2YWx1YXRlLAogICAgICAgICAgICAgZ3JvdXAgPSBFdmFsdWF0ZSkpICsKICBnZW9tX3BvaW50KGNvbG9yID0gIiMzYTNhM2EiLCBzaXplID0gMikgKwogIGdlb21fcGF0aChjb2xvciA9ICIjM2EzYTNhIikgKwogIGxhYnModGl0bGUgPSBOVUxMLAogICAgICAgeCA9ICJDb3JyZWxhdGlvbiBNZXRob2RzIiwKICAgICAgIHkgPSBOVUxMKSArCiAgc2NhbGVfeF9kaXNjcmV0ZShndWlkZSA9IGd1aWRlX2F4aXMobi5kb2RnZSA9IDIpKSArCiAgZmFjZXRfZ3JpZChjb3JyZWxhdGlvbiB+IG4pICsKICB0aGVtZV9idygpICsKICB0aGVtZSgKICAgIHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAwLjUsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNpemUgPSAxMiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZmFjZSA9ICJib2xkIiksCiAgICBwbG90LnN1YnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSwKICAgIHRleHQgPSBlbGVtZW50X3RleHQoCiAgICAgIHNpemUgPSAxMSwKICAgICAgZmFjZT0iYm9sZCIpLCAKICAgIGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dCgKICAgICAgc2l6ZSA9IDksCiAgICAgIGZhY2U9InBsYWluIiwKICAgICAgY29sb3VyPSJibGFjayIpLAogICAgIyBheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDkwKSwKICAgIGF4aXMudGl0bGUueCA9IGVsZW1lbnRfdGV4dCgKICAgICAgc2l6ZSA9IDExLAogICAgICBtYXJnaW4gPSBtYXJnaW4odCA9IDcsIHIgPSAwLCBiID0gMCwgbCA9IDApCiAgICApLAogICAgc3RyaXAudGV4dCA9IGVsZW1lbnRfdGV4dCgKICAgICAgc2l6ZSA9IDExCiAgICApLAogICAgbGVnZW5kLnRpdGxlID0gZWxlbWVudF9ibGFuaygpLAogICAgbGVnZW5kLnRleHQgPSBlbGVtZW50X3RleHQoCiAgICAgIGZhY2U9InBsYWluIiwKICAgICAgY29sb3VyPSJibGFjayIsCiAgICAgIHNpemU9MTApLAogICAgcGFuZWwuc3BhY2luZyA9IHVuaXQoMC44LCAibGluZXMiKQogICkgIAoKIyBnZ3NhdmUoZmlsZW5hbWUgPSAiaW1nL0V2YWx1YXRlX2NvcnJlbGF0aW9uX1JNU0VBX0JpYXNfZGF0YV9leGFtcGxlX0EucG5nIiwKIyAgICAgICAgcGxvdCA9IHBsb3RfZXZfZGF0YV9BLCB3aWR0aCA9IDEwLjc1LCBoZWlnaHQgPSA3LAojICAgICAgICBkcGkgPSAzMDApCmBgYAoKCmBgYHtyIGVjaG89RkFMU0UsIG91dC53aWR0aD0nMTAwJSd9CmtuaXRyOjppbmNsdWRlX2dyYXBoaWNzKCJpbWcvRXZhbHVhdGVfY29ycmVsYXRpb25fUk1TRUFfQmlhc19kYXRhX2V4YW1wbGUucG5nIikKYGBgCgoK